#lang racket
;; FILE: cminus_mc.rkt
;; AUTHORS: Eric Zimmer, Corey Bilski
;; COURSE: CS4121 Programming Languages
;; SECTION: R01

;; Import the parser and lexer generators.
(require parser-tools/yacc
         parser-tools/lex
         (prefix-in : parser-tools/lex-sre))

;; -------------------
;; Zero Page Locations
;; -------------------
;; Math Variables
(define MATH1LO #x10) ;; augend, subtrahend
(define MATH1HI #x11) 
(define MATH2LO #x12) ;; addend, minuend
(define MATH2HI #x13)
(define MATH3LO #x14) ;; sum, difference
(define MATH3HI #x15)
(define MATH4LO #x16)
(define MATH4HI #x17)
(define MATH5LO #x18)
(define MATH5HI #x19)
(define MATH6LO #x1A)
(define MATH6HI #x1B)
(define MATH7LO #x1C)
(define MATH7HI #x1D)
(define MATH8LO #x1E)
(define MATH8HI #x1F)

;; Work Space
(define WORK1LO #x20)
(define WORK1HI #x21)

;; Symbol Table
(define VARS #x30) ;$30 - $7F

;; Memory Mapped I/O
(define IOFROB #xFD)
(define IOINTL #xFE)
(define IOINTH #xFF)

;; ---------------
;; ROM Subroutines
;; ---------------
(define ADD #xF000)
(define SUBTRACT #xF00E)

(define-tokens value-tokens (NUM VAR FNCT))
(define-empty-tokens op-tokens (= == != > < >= <= OP CP + - * / ^ EOF NEG CB OB SC NL INT VOID ID IF ELSE WHILE))

;; A hash table to store variable values in for the calculator
(define vars (make-hash))

(define-lex-abbrevs
  (lower-letter (:/ "a" "z"))
  (upper-letter (:/ #\A #\Z))
  ;; (:/ 0 9) would not work because the lexer does not understand numbers.
  ;; But (:/ #\0 #\9) is ok.
  (digit (:/ "0" "9")))

(define calcl
  (lexer
   [(eof) 'EOF]
   ;; recursively call the lexer on the remaining input after a tab or space.
   ;; Returning the result of that operation.  
   ;; This effectively skips all whitespace.
   [(:or #\return #\newline #\tab #\space) (calcl input-port)]
   ;; (token-newline) returns 'newline
   ;; Since (token-=) returns '=, just return the symbol directly
   [(:or "=" "+" "-" "*" "/" "^" "==" "!=" ">" "<" ">=" "<=") (string->symbol lexeme)]
   ["int" 'INT]
   ["main" 'ID]
   ["void" 'VOID]
   ["#\newline" 'NL]
   ["(" 'OP]
   ["while" 'WHILE]
   [")" 'CP]
   ["{" 'OB]
   ["}" 'CB]
   [";" 'SC]
   ["if" 'IF]
   ["else" 'ELSE]
   ["sin" (token-FNCT sin)]
   [(:+ digit) (token-NUM (string->number lexeme))]
   [(:: (:+ digit) #\. (:* digit)) (token-NUM (string->number lexeme))]
   [(:+ (:or lower-letter upper-letter)) (token-VAR (string->symbol lexeme))]
   ))

(define calcp
  (parser
   (start start)
   (end EOF)
   (suppress)
   (tokens value-tokens op-tokens)
   (error (lambda (a b c) (void)))
   (precs (right =)
          (left - +)
          (left * /)
          (left NEG)
          (right ^))
   (grammar
    (start [() #f]
           ;; If there is an error, ignore everything before the error
           ;; and try to start over right after the error
           [(error start) $2]
           [(program) $1]
           [(NL program) $2])
    ;;setting up the grammar as defined in the c-minus book
    (program 
     [(declaration) $1])
    (declaration
     [(fun-declaration) $1])
    (fun-declaration
     [(type-specifier ID compound) (void)])
    (type-specifier
     [(VOID) (void)]
     [(INT) (void)])
    (statement-list
     [(statement-list statement) (void)]
     [(statement) $1]
     [() (void)])
        ;; Statements and things
    (statement
     [(compound) (void)]
     [(expression-statement) $1]
     [(selection-statement) $1]
     [(iteration-statement) $1])
    (compound
     [ ( OB statement-list CB) $2])
    (expression-statement
     [(expression SC) $1]
     [(SC) (void)])
    (selection-statement
     [(IF OP expression CP statement) (void)]
     [(IF OP expression CP statement ELSE statement) (void)])
    (iteration-statement
     [(WHILE OP expression CP statement) (void)])
    (expression
     [(exp) $1])
    (exp [(NUM) (let-values ([(lo hi hexLo hexHi) (int->16bit $1)])
                  ;; Assembly Code
                  ;; Push number onto stack
;                  (printf "LDA #$~a~n" hexHi)
;                  (printf "PHA~n")
;                  (printf "LDA #$~a~n" hexLo)
;                  (printf "PHA~n")
                  (printf "A9 ~a 48 A9 ~a 48 " hexHi hexLo)
                  $1)
                ]
         [(VAR) (begin
                  ;; Assembly Code
                  ;; Retrieve variable value from Symbol Table
                  ;; Push value onto Stack
;                  (printf "LDX #$~a~n" (8bit->hex (symbol->var-lookup $1)))
;                  (printf "INX~n")
;                  (printf "INX~n")
;                  (printf "LDA *$~a,X~n" (8bit->hex VARS))
;                  (printf "PHA~n")
;                  (printf "DEX~n")
;                  (printf "LDA *$~a,X~n" (8bit->hex VARS))
;                  (printf "PHA~n")
                  (printf "A2 ~a E8 E8 B5 ~a 48 CA B5 ~a 48 " 
                          (8bit->hex (symbol->var-lookup $1))
                          (8bit->hex VARS)
                          (8bit->hex VARS))
                  (hash-ref vars $1 (lambda () 0)))]
         [(VAR = exp) (let-values ([(lo hi hexLo hexHi) (int->16bit $3)])
                        ;; Assembly Code
                        ;; Pull right-hand expression off Stack
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex WORK1LO))
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex WORK1HI))
                        (printf "68 85 ~a 68 85 ~a " 
                                (8bit->hex WORK1LO)
                                (8bit->hex WORK1HI))
                        ;; Lookup variable location in Symbol Table
                        ;; Store expression value in variable
                        ;; Push value onto Stack
;                        (printf "LDX #$~a~n" (8bit->hex (symbol->var-lookup $1)))
;                        (printf "INX~n")
;                        (printf "INX~n")
;                        (printf "LDA *$~a~n" (8bit->hex WORK1HI))
;                        (printf "STA *$~a,X~n" (8bit->hex VARS))
;                        (printf "PHA~n")
;                        (printf "DEX~n")
;                        (printf "LDA *$~a~n" (8bit->hex WORK1LO))
;                        (printf "STA *$~a,X~n" (8bit->hex VARS))
;                        (printf "PHA~n")
                        (printf "A2 ~a E8 E8 A5 ~a 95 ~a 48 CA A5 ~a 95 ~a 48 " 
                                (8bit->hex (symbol->var-lookup $1))
                                (8bit->hex WORK1HI)
                                (8bit->hex VARS)
                                (8bit->hex WORK1LO)
                                (8bit->hex VARS))
                        (hash-set! vars $1 $3)
                        $3)]
         [(FNCT OP exp CP) ($1 $3)]
         ;; addition
         [(exp + exp) (let-values ([(lo hi hexLo hexHi) (int->16bit ADD)])
                        ;; Assembly Code
                        ;; Pull Right-hand expression off Stack
                        ;; Store in Addend workspace
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex MATH2LO))
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex MATH2HI))
                        (printf "68 85 ~a 68 85 ~a " 
                                (8bit->hex MATH2LO)
                                (8bit->hex MATH2HI))
                        ;; Pull Left-hand expression off Stack
                        ;; Store in Augend workspace
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex MATH1LO))
;                        (printf "PLA~n")
;                        (printf "STA *$~a~n" (8bit->hex MATH1HI))
                        (printf "68 85 ~a 68 85 ~a " 
                                (8bit->hex MATH1LO)
                                (8bit->hex MATH1HI))
                        ;; Call ADD subroutine
;                        (printf "JSR $~a~a~n" hexHi hexLo)
                        (printf "20 ~a ~a " hexLo hexHi) ;; <==== byte reversal!!!
                        ;; Push sum onto Stack
                        (printf "A5 ~a 48 A5 ~a 48 " 
                                (8bit->hex MATH3HI)
                                (8bit->hex MATH3LO))
                        (+ $1 $3))
                      ]
         ;; subtraction
         [(exp - exp) (let-values ([(lo hi hexLo hexHi) (int->16bit SUBTRACT)])
                        ;; Assembly Code
                        ;; Pull Right-hand expression off Stack
                        ;; Store in Minuend workspace
;                        (printf "PLA~n")
                        (printf "68 ")
;                        (printf "STA *$~a~n" (8bit->hex MATH2LO))
                        (printf "85 ~a " (8bit->hex MATH2LO))
;                        (printf "PLA~n")
                        (printf "68 ")
;                        (printf "STA *$~a~n" (8bit->hex MATH2HI))
                        (printf "85 ~a " (8bit->hex MATH2HI))
                        ;; Pull Left-hand expression off Stack
                        ;; Store in Subtrahend workspace
;                        (printf "PLA~n")
                        (printf "68 ")
;                        (printf "STA *$~a~n" (8bit->hex MATH1LO))
                        (printf "85 ~a " (8bit->hex MATH1LO))
;                        (printf "PLA~n")
                        (printf "68 ")
;                        (printf "STA *$~a~n" (8bit->hex MATH1HI))
                        (printf "85 ~a " (8bit->hex MATH1HI))
                        ;; Call SUBTRACT subroutine
;                        (printf "JSR $~a~a~n" hexHi hexLo)
                        (printf "20 ~a ~a " hexLo hexHi) ;; <--- byte reversal!!
                        ;; Push difference onto Stack
;                        (printf "LDA *$~a~n" (8bit->hex MATH3HI))
                        (printf "A5 ~a " (8bit->hex MATH3HI))
;                        (printf "PHA~n")
                        (printf "48 ")
;                        (printf "LDA *$~a~n" (8bit->hex MATH3LO))
                        (printf "A5 ~a " (8bit->hex MATH3LO))
;                        (printf "PHA~n")
                        (printf "48 ")
                        (- $1 $3))
                      ]
         ;; multiplication
         [(exp * exp)  (let-values ([(lo hi hexLo hexHi) (int->16bit ADD)])
                         (let ((mOne $1) (mTwo $3) (c 1))
                           ;; Pull the right hand from the stack
                           ;; Store it in the addend workspace
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH2LO))
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH2HI))
                           (printf "68 68 ")
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH1LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH1HI))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH3LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH3HI))
                           ;; call multiply helper function
                           (multiply 1 mOne mTwo hexLo hexHi)
                           (printf "A5 ~a 48 A5 ~a 48 " 
                                (8bit->hex MATH3HI)
                                (8bit->hex MATH3LO))
                           )
                         )]
         ;; division
         [(exp / exp) (let-values ([(lo hi hexLo hexHi) (int->16bit ADD)])
                         (let ((mOne $1) (mTwo $3) (c 1))
                           ;; Pull the right hand from the stack
                           ;; Store it in the addend workspace
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH1LO))
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH1HI))
                           ;; Pull down the left side and store it in 4
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH4LO))
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH4HI))
                           ;; Store 0 in 2
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH2LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH2HI))
                           ;; And 3, to be clean
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH3LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH3HI))
                            ;; And 5!
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH5LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH5HI))
                           ;; Divide
                           (divide 0 $1 $3 hexLo hexHi)
                           (printf "A5 ~a 48 A5 ~a 48 " 
                                (8bit->hex MATH5HI)
                                (8bit->hex MATH5LO))
                           )
                         )]
         ;; exponasize
         [(exp ^ exp) (let-values ([(lo hi hexLo hexHi) (int->16bit ADD)])
                         (let ((mOne $1) (mTwo $3) (c 1))
                           ;; Pull of exponent and trash it
                           (printf "68 68 ")
                           (printf "68 ")
                           ;; store left hand into MATH3
                           (printf "85 ~a " (8bit->hex MATH3LO))
                           (printf "68 ")
                           (printf "85 ~a " (8bit->hex MATH3HI))        
                           (printf "A9 00 ")
                           ;; store 0 into MATH1
                           (printf "85 ~a " (8bit->hex MATH1LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH1HI))
                           (printf "A9 00 ")
                           ;; store 0 into MATH2
                           (printf "85 ~a " (8bit->hex MATH2LO))
                           (printf "A9 00 ")
                           (printf "85 ~a " (8bit->hex MATH2HI))
                           ;; call exponent
                           (exponent 1 mOne mTwo hexLo hexHi)
                           (printf "A5 ~a 48 A5 ~a 48 " 
                                (8bit->hex MATH3HI)
                                (8bit->hex MATH3LO))
                           )
                         )]
         [(OP exp CP) $2]
         [(exp == exp) (void)]
         [(exp >= exp) (void)]
         [(exp <= exp) (void)]
         [(exp != exp) (void)]
         [(exp < exp) (void)]
         [(exp > exp) (void)]
         ))))

;; Exponent helper function
(define (exponent c mOne mTwo hexLo hexHi)
  ;; If exponent is 0, store 1
  (if (eq? mTwo 0)
      ((printf "A5 01 ")
       (printf "85 ~a " (8bit->hex MATH3LO))
       (printf "A5 00 ")
       (printf "85 ~a " (8bit->hex MATH3HI)))
      ;; If exponent is 1, store mOne into MATH3
      (if (eq? mTwo 1)
          (void)
          (if (>= c mTwo)
              (void)
              (let ((x 5))
                ;; Store the sum in the first add spot
                ;; move 3 to 2
                (printf "A5 ~a " (8bit->hex MATH3LO))
                (printf "85 ~a " (8bit->hex MATH2LO))
                (printf "A5 ~a " (8bit->hex MATH3HI))
                (printf "85 ~a " (8bit->hex MATH2HI))
                ;; store 0 in register 1
                (printf "A5 00 ")
                (printf "85 ~a " (8bit->hex MATH1LO))
                (printf "A5 00 ")
                (printf "85 ~a " (8bit->hex MATH1HI))
                ;; multiplyyyyyyy
                (multiply 1 mOne mTwo hexLo hexHi)
                ;; Recur
                (exponent (+ 1 c) mOne mTwo hexLo hexHi)
                )
  ))))

;; Devide helper function
(define (divide sum high low hexLo hexHi)
  ;; Keep going until the low + sum is greater than
  ;; equal to hight
  (if (<= (+ sum low) high)
      (let ((x 5))
        (printf "20 ~a ~a " hexLo hexHi)
        ;; Store the small from 1 to 6
        (printf "A5 ~a " (8bit->hex MATH1LO))
        (printf "85 ~a " (8bit->hex MATH6LO))
        (printf "A5 ~a " (8bit->hex MATH1HI))
        (printf "85 ~a " (8bit->hex MATH6HI))
         ;; Store the sum from 3 to 7
        (printf "A5 ~a " (8bit->hex MATH3LO))
        (printf "85 ~a " (8bit->hex MATH7LO))
        (printf "A5 ~a " (8bit->hex MATH3HI))
        (printf "85 ~a " (8bit->hex MATH7HI))
        ;; Put "1" in 1
        (printf "A9 01 ")
        (printf "85 ~a " (8bit->hex MATH1LO))
        (printf "A9 00 ")
        (printf "85 ~a " (8bit->hex MATH1HI))
        ;; Store count from 5 in 2
        (printf "A5 ~a " (8bit->hex MATH5LO))
        (printf "85 ~a " (8bit->hex MATH2LO))
        (printf "A5 ~a " (8bit->hex MATH5HI))
        (printf "85 ~a " (8bit->hex MATH2HI))
        ;; Add
        (printf "20 ~a ~a " hexLo hexHi)
        ;; Store count from 3 back in 5
        (printf "A5 ~a " (8bit->hex MATH3LO))
        (printf "85 ~a " (8bit->hex MATH5LO))
        (printf "A5 ~a " (8bit->hex MATH3HI))
        (printf "85 ~a " (8bit->hex MATH5HI))
        ;; Put small back from 6 to 1
        (printf "A5 ~a " (8bit->hex MATH6LO))
        (printf "85 ~a " (8bit->hex MATH1LO))
        (printf "A5 ~a " (8bit->hex MATH6HI))
        (printf "85 ~a " (8bit->hex MATH1HI))
        ;; Put sum from 7 back in 2
        (printf "A5 ~a " (8bit->hex MATH7LO))
        (printf "85 ~a " (8bit->hex MATH2LO))
        (printf "A5 ~a " (8bit->hex MATH7HI))
        (printf "85 ~a " (8bit->hex MATH2HI))
        ;;recur
        (divide (+ sum low) high low hexLo hexHi))
      ;;print answer if we are done
      (/ high low)))

;; Multiply helper function
(define (multiply c mOne mTwo hexLo hexHi)
  ;; Check to see if we have run mOne times
  (if (> c mOne)
      ;; if we have print out
      (* mOne mTwo)
      ;; dummy let for recursion
      (let ((x 5))
        ;; Call add
        (printf "20 ~a ~a " hexLo hexHi)
        ;; Store the sum in the first add spot
        (printf "A5 ~a " (8bit->hex MATH3LO))
        (printf "85 ~a " (8bit->hex MATH1LO))
        (printf "A5 ~a " (8bit->hex MATH3HI))
        (printf "85 ~a " (8bit->hex MATH1HI))
        ;; Recur
        (multiply (+ 1 c) mOne mTwo hexLo hexHi)
        )
  ))

;; -------------------------------
;; DECIMAL / BINARY NUMBER FORMATS
;; -------------------------------
;; Convert an integer to the 6502 Lo/Hi-byte 16-bit Integer format.
;; Returns bytes and integers and hex strings.
(define (int->16bit arg)
  (let ((i (bitwise-and arg #xFFFF))
        (lo 0)
        (hi 0))
    (when (< i 0) 
      ;; Use Two's Compliment for negative numbers
      (set! i (+ (bitwise-xor i #xFFFF) 1)))
    (set! lo (bitwise-and i #x00FF))
    (set! hi (/ (bitwise-and i #xFF00) 256))
    (values lo hi 
            (8bit->hex lo)
            (8bit->hex hi))))

;; Convert 6502 Lo/Hi-bytes to an integer.
(define (16bit->int lo hi)
  (let ((i 0))
    (cond ((> (bitwise-and hi #x80) 0) 
           ;; Use Two's Compliment for negative numbers
           (set! i (- (+ (* (bitwise-xor hi #xFF) 256) (bitwise-xor lo #xFF) 1))))
          (#t (set! i (+ (* hi 256) lo))))
    i))

;; Converts an 8-bit integer (< 256) to a 2-digit hex string.
(define (8bit->hex number)
  (let ((padded (string-upcase (string-append "0" (number->string number 16)))))
    (substring padded (- (string-length padded) 2))))

;; Do the math locally to calculate index of variable in Symbol Table
(define (symbol->var-lookup var)
  (*
   (- (bytes-ref (string->bytes/utf-8 (string-upcase (symbol->string var))) 0)
      65)
   3))
    
(define (compile source object)
  (with-output-to-file object
    (lambda () (calc (open-input-file source))) #:exists 'replace))

;; run the calculator on the given input-port       
(define (calc ip)
;  (display "*=$D000")
  (display "D000") ;; NOT LITTLE-ENDIAN!!!!!
  (newline)
  (port-count-lines! ip)
  (letrec ((one-line
            (lambda ()
              (let ((result (calcp (lambda () (calcl ip)))))
                (when result
                  ;; Assembly Code
                  ;; EOL pull last value off stack and print result
;                  (printf "PLA~n")
;                  (printf "STA *$~a~n" (8bit->hex IOINTL))
;                  (printf "PLA~n")
;                  (printf "STA *$~a~n" (8bit->hex IOINTH))
;                  (printf "STA *$~a~n" (8bit->hex IOFROB))
                  (printf "68 85 ~a 68 85 ~a 85 ~a " 
                          (8bit->hex IOINTL) 
                          (8bit->hex IOINTH)
                          (8bit->hex IOFROB))
                  ;; Scheme result
                  ;; (printf "~a\n" result)
                  (one-line))))))
    (one-line))
;  (display "HLT") ;; Hex 02
  (display "02") ;; Hex 02
  (newline)
;  (display ".end")
  (display "FFFFFF") ;; Hex 02
;  (newline)
  )

;; Some examples
(compile "test.c" "out.obj")